Index
Aufgabe
Ein Datenprojekt Ihrer Wahl. Dies muss nicht in R realisiert sein, kann mit einem Werkzeug Ihrer Wahl entstehen.
Ziel: Text und überzeugende Darstellung der Ergebnisse.
1 Unfalldaten
Das Statistische Bundeamt stellt eine vielzahl an unterschiedlichen Datensätzen zur Verfügung. In diesem Dokument werden offizielle Unfalldaten mit Personenschaden für Regensburg ausgewertet. Diese können hier heruntergeladen werden.
library(tidyverse)
library(lubridate)filenames <-
list.files(
path = here::here("data-raw/accidents")
)ReadGarbageData <- function(filename){
# read a file
data <- read_csv2(here::here("data-raw/accidents", filename))
# the files have different headers
# this key corrects that
col_key <-
c(
# ids
FID = "id1",
OBJECTID = "id2",
OBJECTID_1 = "id2",
UIDENTSTLA = "id3",
UIDENTSTLAE = "id3",
# lighting
ULICHTVERH = "light_condition",
LICHT = "light_condition",
# street condition
IstStrasse = "street_condition",
STRZUSTAND = "street_condition",
# other
IstSonstig = "other",
IstSonstige = "other",
# common
ULAND = "land",
UREGBEZ = "bezirk",
UKREIS = "kreis",
UGEMEINDE = "gemeinde",
UJAHR = "year",
UMONAT = "month",
USTUNDE = "hour",
UWOCHENTAG = "weekday",
UKATEGORIE = "severity",
UART = "kind_of_accident",
UTYP1 = "type_of_accident",
IstRad = "bicycle",
IstKrad = "bike",
IstPKW = "car",
IstFuss = "pedestrian",
IstGkfz = "truck",
LINREFX = "linref_x",
LINREFY = "linref_y",
XGCSWGS84 = "lng",
YGCSWGS84 = "lat"
)
# correct col names via the key
names(data) <- col_key[names(data)]
# correct col types
data <-
data |>
mutate(
bezirk = as.character(bezirk),
year = as.numeric(year),
month = as.numeric(month),
hour = as.numeric(hour)
)
return(data)
}data <-
filenames |>
map_dfr(
ReadGarbageData
) |>
select(-starts_with("id"))data <-
data |>
filter(
land == "09" &
bezirk == "3" &
kreis == "62" &
gemeinde == "000"
) |>
select(-kind_of_accident, -type_of_accident, -linref_x, -linref_y) |>
select(-land, -bezirk, -kreis, -gemeinde)
# add id
data <-
data |>
mutate(
id = row_number()
) |>
select(id, everything())data <-
data |>
mutate(
datetime = glue::glue("{month}-{year}-{hour}") |>
parse_datetime(format = "%m-%Y-%H")
) |>
mutate(
weekday = wday(weekday, label = TRUE),
date = date(datetime)
) |>
mutate(
across(
.cols = c(severity, light_condition, street_condition),
.fns = as_factor
)
) |>
mutate(
across(
.cols = bicycle:other,
.fns = as.logical
)
) |>
mutate(
severity = fct_recode(
severity,
"Toedlich" = "1",
"Schwer" = "2",
"Leicht" = "3"
),
light_condition = fct_recode(
light_condition,
"Tageslicht" = "0",
"Dämmerung" = "1",
"Dunkelheit" = "2"
),
street_condition = fct_recode(
street_condition,
"Trocken" = "0",
"Nass/Feucht" = "1",
"Winterglatt" = "2"
)
)data |>
DT::datatable()1.1 Geocode
# pb <-
# progress::progress_bar$new(
# format = "Lade Geodaten :current/:total [:bar] :percent (eta: :eta)",
# total = nrow(data)
# )
#
# pb$tick(0)
#
# data <-
# map2_dfr(
# .x = data$lng,
# .y = data$lat,
# .f = function(x = .x, y = .y){
#
# geodata <- photon::reverse(x, y) |>
# select(name:country)
#
# pb$tick()
#
# return(geodata)
# }
# ) |>
# mutate(
# id = row_number(),
# street = ifelse(is.na(street), name, street)
# ) |>
# right_join(data, by = c("id"))
#
# remove(pb)1.2 CSV/RDA speichern.
# data
write_csv2(
x = data,
file = here::here("output/regensburg_data.csv")
)
save(
list = c("data"),
file = here::here("data/regensburg_data.rda")
)2 Shapefiles
library(tidyverse)
library(sf)Die restlichen Shapefiles (Stadtgrenze, Stadtteile, Gewässer, Autobahnen) stammen vom Amt für Stadtentwicklung Regensburg
2.1 Stadtgrenze Regensburg
sf.regensburg <-
read_sf(here::here("data-raw/shapefiles/regensburg/gesamtstadt.shp")) |>
st_transform("WGS84") |>
rename(
"m2" = qm
) |>
select(m2, geometry)ggplot() +
geom_sf(data = sf.regensburg) +
ggthemes::theme_map()2.2 Stadtteile
sf.districts <-
read_sf(here::here("data-raw/shapefiles/districts/stadtbezirke.shp")) |>
st_transform("WGS84") |>
rename(
"district" = Name,
"ha" = Hektar
) |>
mutate(
m2 = ha * 10^4
) |>
select(district, m2, geometry)ggplot() +
geom_sf(data = sf.districts, linetype = 2) +
geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
ggthemes::theme_map()2.3 Autobahnen
sf.highways <-
read_sf(here::here("data-raw/shapefiles/highways/autobahn.shp")) |>
st_transform("WGS84") |>
rename(
"feeder" = ZUBRINGER
) |>
mutate(
feeder = case_when(
feeder == "j" ~ TRUE,
feeder == "n" ~ FALSE
)
)ggplot() +
geom_sf(data = sf.districts, linetype = 2) +
geom_sf(data = sf.highways, alpha = 0.6) +
geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
ggthemes::theme_map()2.4 Flüsse
sf.rivers <-
read_sf(here::here("data-raw/shapefiles/rivers/gewaesser.shp")) |>
st_transform("WGS84") |>
select(geometry)ggplot() +
geom_sf(data = sf.districts, linetype = 2) +
geom_sf(data = sf.rivers, alpha = 0.6) +
geom_sf(data = sf.highways, alpha = 0.6) +
geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
ggthemes::theme_map()2.5 Finale Karte
ggplot() +
geom_sf(data = sf.districts, aes(fill = district), alpha = 0.7) +
geom_sf(data = sf.rivers, alpha = 0.7, fill = "lightblue") +
geom_sf(data = sf.regensburg, lwd = 1, alpha = 0) +
theme_void() +
theme(
legend.position = "right",
legend.title = element_blank()
)3 Leaflet Karte
library(tidyverse)
library(leaflet)
library(sf)sf.data <-
data |>
st_as_sf(coords = c("lng", "lat"), crs = "WGS84")3.1 Basemap
bounds <- sf.regensburg |> st_bbox()
map <-
leaflet(
options = leafletOptions(
crs = leafletCRS(code = "WGS84"),
preferCanvas = NULL
)
) |>
addProviderTiles(
provider = providers$OpenStreetMap.DE,
group = "OSM",
options = providerTileOptions(minZoom = 11)
) |>
setView(
lng = (as.numeric(bounds[1]) + as.numeric(bounds[3]))/2,
lat = (as.numeric(bounds[2]) + as.numeric(bounds[4]))/2,
zoom = 12
) |>
setMaxBounds(
lng1 = as.numeric(bounds[1] - 0.015),
lat1 = as.numeric(bounds[2] - 0.015),
lng2 = as.numeric(bounds[3] + 0.015),
lat2 = as.numeric(bounds[4] + 0.015)
)3.2 Marker
custom_popup <- function(data, header) {
text <-
glue::glue(
"<b>{header}</b> ",
"<br>",
"{data$month}/{data$year} ({data$hour} Uhr)"
)
return(text)
}map <-
map |>
addAwesomeMarkers(
data = data |> filter(severity == "Toedlich"),
group = "Tödliche Unfälle",
lng = ~lng,
lat = ~lat,
icon = awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = "red"
),
clusterOptions = markerClusterOptions(),
popup = custom_popup(
data = data |> filter(severity == "Toedlich"),
header = "Tödlicher Unfall"
)
) |>
addAwesomeMarkers(
data = data |> filter(severity == "Schwer"),
group = "Schwere Unfälle",
lng = ~lng,
lat = ~lat,
icon = awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = "orange"
),
clusterOptions = markerClusterOptions(),
popup = custom_popup(
data = data |> filter(severity == "Schwer"),
header = "Schwerer Unfall"
)
) |>
addAwesomeMarkers(
data = data |> filter(severity == "Leicht"),
group = "Leichte Unfälle",
lng = ~lng,
lat = ~lat,
icon = awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = "beige"
),
clusterOptions = markerClusterOptions(),
popup = custom_popup(
data = data |> filter(severity == "Leicht"),
header = "Leichter Unfall"
)
)3.3 Stadtteile als Shapefile
custom_label <- function(data) {
text <- glue::glue(
"{data$district}: {data$n} Unfälle"
)
return(text)
}districts <-
data |>
st_as_sf(coords = c("lng", "lat"), crs = "WGS84") |>
rename(
points = geometry
) |>
st_join(
y = sf.districts |> rename("district_shape" = geometry),
join = st_within,
left = TRUE
) |>
select(-m2) |>
as_tibble() |>
left_join(
y = sf.districts |> rename("district_polygon" = geometry) ,
by = "district"
) |>
drop_na(district) |>
mutate(
district = as_factor(district) |>
fct_infreq() |>
fct_rev()
) |>
add_count(district) |>
select(district, district_polygon, n) |>
unique() |>
st_as_sf()map <-
map |>
addPolygons(
data = districts,
group = "Stadtteile",
opacity = 1,
weight = 0.5,
fillOpacity = 0.5,
color = "black",
fillColor = ~colorNumeric("viridis", n)(n),
highlightOptions = highlightOptions(
color = "white",
weight = 2,
bringToFront = TRUE
),
label = ~custom_label(data = districts)
)3.4 Bedienelemente
map <-
map |>
addProviderTiles(
provider = providers$Stamen.TonerBackground,
group = "Stadtteile",
options = providerTileOptions(minZoom = 11)
) |>
addLayersControl(
baseGroups = c("OSM", "Stadtteile"),
overlayGroups = c("Tödliche Unfälle", "Schwere Unfälle", "Leichte Unfälle"),
options = layersControlOptions(collapsed = FALSE)
)3.5 Finale Karte
map4 Auswertung
Zur besseren Lesbarkeit wird der R Code in diesem Kapitel nicht gezeigt. Dieser besteht größtenteils aus Plots und ist bis auf wenige Ausnahmen nicht weiter relevant.
Im Stadtgebiet Regensburg geschahen von den Jahren 2016 bis 2020 insgesamt 3167 Unfälle mit Personenschaden. Abbildung 4.1 zeigt die monatlichen Unfälle in diesem Zeitraum.
Abbildung 4.1: Monatliche Unfälle in Regensburg.
Während sich kein eindeutiger Auf- oder Abwärtstrend feststellen lässt, zeigen die Daten dennoch eine Jährliche Periodizität: Im Sommer finden die meisten Unfälle mit Personenschaden statt, während die Anzahl der Unfälle von Herbst bis Frühjahr sinkt.
Abbildung 4.2 zeigt die Anzahl der jährlichen Unfälle in Regensburg. Im Jahr 2020 zeigt sich ein Rückgang von 25%. Dieser kann auf geringeren Verkehr aufgrund der Corona Pandemie zurückgeführt werden. Dies wird durch Abbildung 4.3 verdeutlicht: Alle dokumentierten Verkehrsmittel hatten einen Rückgang der jährlichen Unfälle von 2019 bis 2020.
Abbildung 4.2: Jährliche Unfälle mit Personenschaden.
Abbildung 4.3 zeigt zudem, dass sich die Anzahl der Unfälle aller Verkehrsmittel außer Fahrrad auf einem fallenden Trend befinden. Die Anzahl der Unfälle mit Fahrradbeteiligung dagegen stieg bis 2020 kontinuierlich an.
Abbildung 4.3: Jährliche Unfälle mit Personenschaden nach Verkehrsteilnehmer unterteilt.
4.1 Unfälle nach Monat
4.2 Unfälle nach Uhrzeit
4.3 Unfälle nach Ortsteil
4.3.1 Absolute Anzahl
4.3.2 Pro Quadratkilometer
Sonstiges
A Dashboard
knitr::include_url("https://kdschneider.shinyapps.io/unfaelle-regensburg/")B Daten
load(
here::here("data/regensburg_data.rda")
)data |>
DT::datatable()